home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0085_Write BANNERS.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-03  |  12KB  |  366 lines
  1. Program BannerC;
  2.  
  3. {$V-}
  4.  
  5. { Written by Scott R. Houck
  6.  
  7.   This program produces banners which can be sent to the screen
  8.   or to a file.  If sent to a file, the output may be appended to
  9.   to an existing file if desired.
  10.  
  11.   The syntax is as follows:
  12.  
  13.     BANNER [/B=banner] [/I=infile] [/O=outfile [/A]] [/C=char]
  14.  
  15.   where
  16.  
  17.     banner  = a character string of maximum length 10
  18.     infile  = an input file containing the banner(s)
  19.     outfile = an output file to which the banner(s) will be written
  20.     char    = character to be used in printing the banner
  21.                 (default = the character being printed)
  22.  
  23.          /A = append to file if it already exists
  24.  
  25.  
  26.   NOTES:
  27.  
  28.     1.  Options may be specified in any order, but there must be
  29.         at least one space between each one.  Do not put spaces
  30.         on either side of the equals sign.
  31.  
  32.     2.  You may use PRN for the filename if you want to send the
  33.         output to the printer. If you choose to do this, do not
  34.         use the /A option.
  35.  
  36.     3.  To indicate a space in the banner when using the /B option, use
  37.         the carat symbol (^).  Example:  BANNER /O=DISKFILE /B=JOHN^DOE
  38.         However, this is not necessary if you are using the /I option.
  39.  
  40.     4.  Valid characters are 0-9, A-Z, and !"#$%&'()*+,-./:;<=>?@[\]
  41.         Any other characters will be printed as a space.
  42.  
  43.     6.  All lower case letters are converted to upper case.
  44.  
  45.     7.  Three blank lines are written before the banner is output.
  46.  
  47.     8.  Note that /B and /I are mutually exclusive and will produce a
  48.         syntax error if used together.
  49.  
  50.     9.  If all options are omitted or if the command line does not contain
  51.         either /B or /I, the command syntax is printed.
  52.  
  53.    10.  /A will produce a syntax error if used without /O.
  54.  
  55.    11.  You may not use < or > with the /B option because DOS would
  56.         interpret it as redirection of standard input and output.
  57.  
  58. }
  59.  
  60. USES DOS,CRT;
  61.  
  62. Type
  63.   str13 = string[13];
  64.   str80 = string[80];
  65.   char_pattern = array[1..10] of integer;
  66.  
  67. Const
  68.   bit_value: array[1..10] of integer = (1,2,4,8,16,32,64,128,256,512);
  69.  
  70.   char_def:  array[#32..#94] of char_pattern = (
  71.  
  72.     {32:' '}   ($000,$000,$000,$000,$000,$000,$000,$000,$000,$000),
  73.     {33:'!'}   ($030,$078,$0FC,$0FC,$078,$078,$030,$000,$030,$030),
  74.     {34:'"'}   ($1CE,$1CE,$1CE,$1CE,$000,$000,$000,$000,$000,$000),     
  75.     {35:'#'}   ($0CC,$0CC,$0CC,$3FF,$0CC,$0CC,$3FF,$0CC,$0CC,$0CC),     
  76.     {36:'$'}   ($030,$1FE,$3FF,$330,$3FF,$1FF,$033,$3FF,$1FE,$030),
  77.     {37:'%'}   ($1C3,$366,$36C,$1D8,$030,$060,$0CE,$19B,$31B,$20E),
  78.     {38:'&'}   ($1E0,$330,$330,$1C0,$1E0,$331,$31A,$31C,$1FA,$0E1),     
  79.     {39:'''}   ($070,$0F8,$078,$010,$020,$000,$000,$000,$000,$000),
  80.     {40:'('}   ($004,$018,$030,$060,$060,$060,$060,$030,$018,$004),
  81.     {41:')'}   ($080,$060,$030,$018,$018,$018,$018,$030,$060,$080),
  82.     {42:'*'}   ($000,$000,$000,$084,$048,$2FD,$048,$084,$000,$000),
  83.     {43:'+'}   ($000,$000,$078,$078,$3FF,$3FF,$078,$078,$000,$000),
  84.     {44:','}   ($000,$000,$000,$000,$000,$070,$0F8,$078,$010,$020),
  85.     {45:'-'}   ($000,$000,$000,$000,$3FF,$3FF,$000,$000,$000,$000),     
  86.     {46:'.'}   ($000,$000,$000,$000,$000,$000,$000,$078,$0FC,$078),
  87.     {47:'/'}   ($001,$003,$006,$00C,$018,$030,$060,$0C0,$180,$100),
  88.     {48:'0'}   ($078,$0FC,$186,$303,$303,$303,$303,$186,$0FC,$078),
  89.     {49:'1'}   ($030,$0F0,$0B0,$030,$030,$030,$030,$030,$3FF,$3FF),
  90.     {50:'2'}   ($1FE,$3FF,$203,$003,$003,$018,$060,$0C0,$3FF,$3FF),
  91.     {51:'3'}   ($3FF,$3FE,$00C,$018,$038,$00E,$006,$203,$3FF,$1FE),
  92.     {52:'4'}   ($01C,$03C,$06C,$0CC,$18C,$3FF,$3FF,$00C,$00C,$00C),
  93.     {53:'5'}   ($3FF,$3FF,$300,$300,$3FE,$3FF,$003,$203,$3FF,$1FE),
  94.     {54:'6'}   ($1FE,$3FF,$301,$300,$3FE,$3FF,$303,$303,$3FF,$1FE),
  95.     {55:'7'}   ($3FF,$3FF,$006,$00C,$018,$030,$060,$0C0,$300,$300),
  96.     {56:'8'}   ($1FE,$3FF,$303,$303,$1FE,$1FE,$303,$303,$3FF,$1FE),
  97.     {57:'9'}   ($1FE,$3FF,$303,$303,$3FF,$1FF,$003,$003,$3FF,$1FE),
  98.     {58:':'}   ($000,$000,$000,$078,$0FC,$078,$000,$078,$0FC,$078),
  99.     {59:';'}   ($000,$038,$07C,$038,$000,$038,$07C,$03C,$004,$008),
  100.     {60:'<'}   ($000,$000,$003,$00C,$030,$0C0,$030,$00C,$003,$000),
  101.     {61:'='}   ($000,$000,$000,$3FF,$3FF,$000,$3FF,$3FF,$000,$000),
  102.     {62:'>'}   ($000,$000,$0C0,$030,$00C,$003,$00C,$030,$0C0,$000),
  103.     {63:'?'}   ($1FE,$3FF,$303,$006,$00C,$018,$018,$000,$018,$018),     
  104.     {64:'@'}   ($1FE,$303,$33B,$36B,$363,$363,$366,$37C,$300,$1FE),     
  105.     {65:'A'}   ($1FE,$3FF,$303,$303,$303,$3FF,$3FF,$303,$303,$303),
  106.     {66:'B'}   ($3FE,$3FF,$303,$303,$3FE,$3FE,$303,$303,$3FF,$3FE),
  107.     {67:'C'}   ($1FE,$3FF,$301,$300,$300,$300,$300,$301,$3FF,$1FE),
  108.     {68:'D'}   ($3FE,$3FF,$303,$303,$303,$303,$303,$303,$3FF,$3FE),
  109.     {69:'E'}   ($3FF,$3FF,$300,$300,$3E0,$3E0,$300,$300,$3FF,$3FF),
  110.     {70:'F'}   ($3FF,$3FF,$300,$300,$3E0,$3E0,$300,$300,$300,$300),
  111.     {71:'G'}   ($1FE,$3FF,$300,$300,$31F,$31F,$303,$303,$3FF,$1FF),
  112.     {72:'H'}   ($303,$303,$303,$303,$3FF,$3FF,$303,$303,$303,$303),
  113.     {73:'I'}   ($3FF,$3FF,$030,$030,$030,$030,$030,$030,$3FF,$3FF),
  114.     {74:'J'}   ($0FF,$0FF,$018,$018,$018,$018,$318,$318,$3F8,$1F0),
  115.     {75:'K'}   ($303,$306,$318,$360,$3E0,$330,$318,$30C,$306,$303),
  116.     {76:'L'}   ($300,$300,$300,$300,$300,$300,$300,$300,$3FF,$3FF),
  117.     {77:'M'}   ($303,$3CF,$37B,$333,$333,$303,$303,$303,$303,$303),
  118.     {78:'N'}   ($303,$383,$343,$363,$333,$333,$31B,$30B,$307,$303),
  119.     {79:'O'}   ($1FE,$3FF,$303,$303,$303,$303,$303,$303,$3FF,$1FE),
  120.     {80:'P'}   ($3FE,$3FF,$303,$303,$3FF,$3FE,$300,$300,$300,$300),
  121.     {81:'Q'}   ($1FE,$3FF,$303,$303,$303,$303,$33B,$30F,$3FE,$1FB),
  122.     {82:'R'}   ($3FE,$3FF,$303,$303,$3FF,$3FE,$318,$30C,$306,$303),
  123.     {83:'S'}   ($1FE,$3FF,$301,$300,$3FE,$1FF,$003,$203,$3FF,$1FE),
  124.     {84:'T'}   ($3FF,$3FF,$030,$030,$030,$030,$030,$030,$030,$030),
  125.     {85:'U'}   ($303,$303,$303,$303,$303,$303,$303,$303,$3FF,$1FE),
  126.     {86:'V'}   ($303,$303,$186,$186,$186,$186,$0CC,$0CC,$078,$030),
  127.     {87:'W'}   ($303,$303,$303,$303,$333,$333,$333,$37B,$1CE,$186),
  128.     {88:'X'}   ($303,$186,$0CC,$078,$030,$078,$0CC,$186,$303,$303),
  129.     {89:'Y'}   ($303,$186,$0CC,$078,$030,$030,$030,$030,$030,$030),
  130.     {90:'Z'}   ($3FF,$3FE,$00C,$018,$030,$030,$060,$0C0,$1FF,$3FF),
  131.     {91:'['}   ($0FE,$0FE,$0C0,$0C0,$0C0,$0C0,$0C0,$0C0,$0FE,$0FE),
  132.     {92:'\'}   ($200,$300,$180,$0C0,$060,$030,$018,$00C,$006,$002),
  133.     {93:']'}   ($0FE,$0FE,$006,$006,$006,$006,$006,$006,$0FE,$0FE),
  134.     {94:'^'}   ($000,$000,$000,$000,$000,$000,$000,$000,$000,$000)    );
  135.  
  136. Var
  137.   character: char;
  138.   banner: str13;
  139.   Param: array[1..4] of str80;
  140.   InfileName, OutfileName: str80;
  141.   Infile, Outfile: text;
  142.   Slash_A, Slash_B, Slash_C, Slash_I, Slash_O: boolean;
  143.  
  144. {----------------------------------------------------------------------}
  145.  
  146. Procedure Beep;
  147.  
  148. begin
  149.   Sound(350);
  150.   Delay(300);
  151.   NoSound;
  152. end;
  153.  
  154. {----------------------------------------------------------------------}
  155.  
  156. Procedure UpperCase(var AnyStr: str80);
  157.  
  158. var
  159.   i: integer;
  160.  
  161. begin
  162.   For i := 1 to length(AnyStr) do AnyStr[i] := UpCase(AnyStr[i]);
  163. end;
  164.  
  165. {----------------------------------------------------------------------}
  166.  
  167. Function Exist(filename: str80): boolean;
  168.  
  169. var
  170.   tempfile: file;
  171.  
  172. begin
  173.   Assign(tempfile,filename);
  174.   {$I-}
  175.   Reset(tempfile);
  176.   {$I+}
  177.   Exist := (IOresult = 0);
  178.   Close(tempfile);
  179. end;
  180.  
  181. {----------------------------------------------------------------------}
  182.  
  183. Procedure Print_Syntax;
  184.  
  185. begin
  186.   Writeln('The syntax is as follows:'^J);
  187.   Writeln('  BANNER [/B=banner] [/I=infile] [/O=outfile [/A]] ',
  188.           '[/C=char]'^J);
  189.   Writeln('where'^J);
  190.   Writeln('  banner  = character string of maximum length 10');
  191.   Writeln('  infile  = input file containing banner text');
  192.   Writeln('  outfile = output file to which the banner(s) will be ',
  193.           'written');
  194.   Writeln('  char    = character to be used in printing the banner');
  195.   Writeln('              (default = the character being printed)'^J);
  196.   Writeln('       /A = append to file if it already exists'^J);
  197.   Writeln('Note that /B and /I are mutually exclusive.');
  198.   Writeln('Use a carat (^) for a space if using /B.');
  199.   Writeln('Valid characters are 0-9, A-Z, and ',
  200.           '!"#$%&''()*+,-./:;<=>?@[\]');
  201. end;
  202.  
  203. {----------------------------------------------------------------------}
  204.  
  205. Procedure Parse;
  206.  
  207. var
  208.   n, b, c, i, o: integer;
  209.   ch1, ch2, ch3: char;
  210.  
  211.   {*} procedure Error;
  212.         begin
  213.           Beep;
  214.           Print_Syntax;
  215.           Halt;
  216.         end;
  217.  
  218. begin  { Parse }
  219.  
  220.   Slash_A := false;
  221.   Slash_B := false;    b := 0;
  222.   Slash_C := false;    c := 0;
  223.   Slash_I := false;    i := 0;
  224.   Slash_O := false;    o := 0;
  225.  
  226.   If ParamCount = 0 then
  227.     begin
  228.       Print_Syntax;
  229.       Halt;
  230.     end;
  231.  
  232.   If ParamCount > 4 then Error;
  233.  
  234.   For n := 1 to ParamCount do
  235.     begin
  236.       Param[n] := ParamStr(n);
  237.       UpperCase(Param[n]);
  238.       ch1 := Param[n][1];
  239.       ch2 := Param[n][2];
  240.       ch3 := Param[n][3];
  241.       If (ch1 <> '/') or not (ch2 in ['A','B','C','I','O']) then Error;
  242.       If ch2 = 'A' then
  243.         Slash_A := true;
  244.       If ch2 = 'B' then
  245.         begin
  246.           Slash_B := true;
  247.           b := n;
  248.         end;
  249.       If ch2 = 'C' then
  250.         begin
  251.           Slash_C := true;
  252.           c := n;
  253.         end;
  254.       If ch2 = 'I' then
  255.         begin
  256.           Slash_I := true;
  257.           i := n;
  258.         end;
  259.       If ch2 = 'O' then
  260.         begin
  261.           Slash_O := true;
  262.           o := n;
  263.         end;
  264.       If (ch2 in ['B','C','I','O']) and (ch3 <> '=') then Error;
  265.       If (ch2 = 'A') and (length(ch2) > 2) then Error;
  266.     end;
  267.  
  268.   If Slash_B and Slash_I then Error;
  269.   If not Slash_B and not Slash_I then Error;
  270.   If Slash_A and not Slash_O then Error;
  271.   If Slash_B then
  272.     begin
  273.       banner := Param[b];
  274.       Delete(banner,1,3);
  275.     end;
  276.   If Slash_C then character := Param[c][4];
  277.   If Slash_I then
  278.     begin
  279.       InfileName := Param[i];
  280.       Delete(InfileName,1,3);
  281.     end;
  282.   If Slash_O then
  283.     begin
  284.       OutfileName := Param[o];
  285.       Delete(OutfileName,1,3);
  286.     end;
  287.  
  288. end;
  289.  
  290. {----------------------------------------------------------------------}
  291.  
  292. Procedure Heading(message: str13);
  293.  
  294. var
  295.   i, j, k: integer;
  296.  
  297. begin
  298.  
  299.   If Slash_O
  300.     then Writeln(Outfile,^M^J^M^J^M^J)
  301.     else Writeln(^J^J^J);
  302.  
  303.   For i := 1 to 10 do
  304.     begin
  305.       For j := 1 to length(message) do
  306.         begin
  307.           If not (message[j] in [#32..#94]) then message[j] := #32;
  308.           For k := 10 downto 1 do
  309.             If char_def[message[j],i] and bit_value[k] = bit_value[k]
  310.               then
  311.                 begin
  312.                   If not Slash_C then character := message[j];
  313.                   If Slash_O
  314.                     then Write(Outfile,character)
  315.                     else Write(character);
  316.                 end
  317.               else
  318.                 begin
  319.                   If Slash_O
  320.                     then Write(Outfile,' ')
  321.                     else Write(' ');
  322.                 end;
  323.               If Slash_O
  324.                 then Write(Outfile,'  ')
  325.                 else Write('  ');
  326.         end;
  327.       If Slash_O
  328.         then Writeln(Outfile)
  329.         else Writeln;
  330.     end;
  331.  
  332. end;
  333.  
  334. {----------------------------------------------------------------------}
  335.  
  336. Begin  { Banner }
  337.  
  338.   Parse;
  339.  
  340.   If Slash_O then
  341.     begin
  342.       Assign(Outfile,OutfileName);
  343.       If Slash_A and Exist(OutfileName)
  344.         then Append(Outfile)
  345.         else Rewrite(Outfile);
  346.     end;
  347.  
  348.   If Slash_I then
  349.     begin
  350.       Assign(Infile,InfileName);
  351.       Reset(Infile);
  352.       While not Eof(Infile) do
  353.         begin
  354.           Readln(Infile,banner);
  355.           UpperCase(banner);
  356.           Heading(banner);
  357.         end;
  358.       Close(Infile);
  359.     end
  360.  
  361.   else Heading(banner);
  362.  
  363.   If Slash_O then Close(Outfile);
  364.  
  365. End.
  366.